perm filename MKVIC.FAI[GEO,BGB]1 blob
sn#001344 filedate 1972-10-28 generic text, type T, neo UTF8
00100 TITLE MKVIC - MAKE A VIDEO INTENSITY CONTOUR - AUGUST 1972.
00200
00300 COMMENT .MKVIC assumes a PAC window of 216 rows by 288 columns,
00400 which is 1728 words, 216 rows by 8 words.
00500
00600 VSEG: BLOCK =1729
00700 HSEG: BLOCK =1736
00800 EXTERN PAC
00900 ISAVED: 0
01000
01100 ;PACXOR - MKVIC INITIALIZATION.
01200 SUBR(PACXOR)
01300 BEGIN PACXOR
01400 I←2
01500 SLAPZ PAC↔LIM HSEG↔BLT HSEG+=1727
01600 SLAPZ PAC↔LIM VSEG↔BLT VSEG+=1727
01700 SETZ I,
01800 LAP PAC↔DAP L+2
01900 L: TRNN I,7↔SETZ 1,↔LAC PAC(I)
02000 XORM HSEG+8(I) ; HSEG bits are above PAC bits.
02100 ROTC -1↔ROT 1,1
02200 XORM VSEG(I) ; VSEG are left of PAC bits.
02300 AOS I
02400 CAIE I,=1728
02500 GO L
02600 SETZM ISAVED
02700 RET0
02800 BEND
02900
03000
03100 ; RPEV - LINK NAMES.
03200
03300 DEFINE CW (A,Q){CAR A,1(Q)} ↔ DEFINE CCW (A,Q){CDR A,1(Q)}
03400 DEFINE CW.(A,Q){DIP A,1(Q)} ↔ DEFINE CCW.(A,Q){DAP A,1(Q)}
03500 DEFINE ARC(A,Q){CDR A,0(Q)} ↔ DEFINE ARC.(A,Q){DAP A,0(Q)}
03600 DEFINE ROW(A,Q){CAR A,-1(Q)}↔DEFINE COL(A,Q){CDR A,-1(Q)}
03700
03800 ; ROW-COL FIXED POINT 0000.00 OPERATIONS.
03900 OPDEF FLO[FSC 225]
00100 ;CHEAP AD HOC DYNAMIC FREE STORAGE ROUTINES.
00200 EXTERN CORGET;
00300 INTERN CORSIZ↔CORSIZ: 0
00400 NIL←777777
00500 AVAIL: NIL
00600 ; PTR ← GETBLK;
00700 SUBR(GETBLK)
00800 BEGIN GETBLK
00900 ACCUMULATORS{PTR,SIZ}
01000 CDR 1,AVAIL
01100 CAIN 1,NIL↔GO L1
01200 CDR (1)↔DAP AVAIL
01300 SETZM 0(1)↔SETZM 1(1)↔SETZM 2(1)↔SETZM 3(1)
01400 MOVEI 4↔ADDM CORSIZ
01500 ADDI 1,1↔RET0
01600 ;GET A BIG BLOCK FROM SAIL.
01700 L1: LAC [XWD 2,AC2]↔BLT AC15
01750 MOVEI 3,=4096
01900 CALL CORGET
02000 GO[FATAL(NO MORE CORE.)]
02200 MOVEI NIL↔DAP (2)↔SUBI 3,4
02300 L2: LAC 2↔ADDI 2,4↔DAP(2)↔SUBI 3,4↔JUMPN 3,L2
02400 DAP 2,AVAIL
02410 LAC [XWD AC2,2]↔BLT 15
02450 GO GETBLK
02500 BEND
02600
02700 ;RELBLK(PTR);
02800 SUBR(RELBLK)
02900 BEGIN RELBLK
03000 LAC 1,ARG1↔SUBI 1,1
03100 SETZM 0(1)↔SETZM 1(1)↔SETZM 2(1)↔SETZM 3(1)
03200 LAC 2,AVAIL↔DAP 2,(1)↔DAP 1,AVAIL
03300 NIM -4↔ADDM CORSIZ
03400 RET1
03500 BEND
03600
03700 ;KLPGON(P)
03800 SUBR(KLPGON)
03900 BEGIN KLPGON
04000 ACCUMULATORS{A2,PGN,E0,Q,R}
04100 LAC PGN,ARG1
04200 CAR E0,1(PGN)
04300 CALL RELBLK,PGN
04400 DAC E0,Q
04500 L: CCW R,Q
04600 CALL RELBLK,Q
04700 CAMN R,E0↔RET1
04800 DAC R,Q↔GO L
04900 BEND
00100 ;THRESHOLD(CUT) - pre-Foonly Version.
00200 SUBR(THRESH)
00300 BEGIN THRESH
00400 EXTERN PAC,TVBUF
00600 I←13 ↔ J←14 ↔ PTR←15
00700 LAC [XWD L,2]↔BLT 11
00800 LAP 4,ARG1↔SLIMZ I,-=1728
00900 LAC PTR,[POINT 6,0,-1]↔LAP PTR,TVBUF
01000 LAP 7,PAC↔GO 2
01100 L: MOVEI J,=36 ;2
01200 ILDB PTR ;3
01300 SUBI ;CUT ;4
01400 ROTC 1 ;5
01500 SOJG J,3 ;6
01600 SETCAM 1,PAC(I) ;7
01700 AOBJN I,2 ;10
01800 RET1 ;11
01900 BEND
00100 ;SUBR SMOOTH (ARCV1,ARCV2,DELTA) - FROM V1 CCW TO V2.
00200 SUBR(SMOOTH)
00300 BEGIN SMOOTH
00400 EXTERN SQRT; CLOBBERS AC1 THRU AC4.
00500 ACCUMULATORS{D,V1,V2,AV1,AV2,A,B,C,S12,E,V,AV}
00600 LAC AV1,ARG3↔LAC AV2,ARG2↔SETZM AVCNT#
00700
00800 ;CHECK FOR TRIVAIL CASE.
00900 L0: ARC V1,AV1↔ARC V2,AV2
01000 CCW E,V1↔CCW 0,E↔CAMN 0,V2↔GO L3
01100
01200 ;COMPUTE NORMALIZED ARC EDGE COEFFICIENTS.
01300 ROW A,AV1↔FLO A, ; A ← Y1.
01400 COL B,AV2↔FLO B, ; B ← X2.
01500 COL C,AV1↔FLO C, ; C ← X1.
01600 ROW D,AV2↔FLO D, ; D ← Y2.
01700 LAC 1,B↔FMPR 1,A ; 1 ← X2*Y1.
01800 FSBR A,D↔FSBR B,C ; A ← Y1-Y2. B ← X2-X1.
01900 FMPR C,D↔FSBR C,1 ; C ← X1*Y2 - X2*Y1.
02000 LAC 0,A↔FMPR 0,0
02100 LAC 1,B↔FMPR 1,1↔FADR 1,0
02200 CALL SQRT,1
02300 FDVR A,1↔FDVR B,1↔FDVR C,1
02400
02500 ;GO FROM V1 CCW TO V2 AND FIND THE V FURTHEST OFF THE ARC-EDGE.
02600 ARC V1,AV1↔ARC V2,AV2
02700 SETZM DMAX#↔SETZM DMIN#
02800 SETZM VMAX#↔SETZM VMIN#
02900 L1: CCW E,V1↔CCW V1,E↔CAMN V1,V2↔GO L2
03000 COL 0,V1↔FLO 0,↔ROW 1,V1↔FLO 1,
03100 FMPR 0,A↔FMPR 1,B↔LAC D,C↔FADR D,0↔FADR D,1
03200 CAMGE D,DMIN↔GO [DAC V1,VMIN↔DAC D,DMIN↔GO .+1]
03300 CAMLE D,DMAX↔GO [DAC V1,VMAX↔DAC D,DMAX↔GO L1]↔GO L1
03400
03500 ;WHEN EXTREMA EXCEED DELTA THEN FORM ARC-POINTS.
03600 L2: LAC V,VMIN↔LACM DMIN
03700 CAMGE DMAX↔LAC V,VMAX↔CAMGE DMAX↔LAC DMAX
03800 CAMGE ARG1↔GO L3
03900
04000 ;OLDE ESPLIT: →CW→ AV2...D...AV...E...AV1 ←CCW←
04100 CALL GETBLK↔DAC 1,E
04200 CALL GETBLK↔DAC 1,AV↔AOS AVCNT
04300 ARC. V,AV↔ARC. AV,V↔LAC -1(V)↔DAC -1(AV)
04400 CW D,AV2↔CCW. D,AV↔CW. AV,D
04500 CW. E,AV↔CCW. E,AV1
04600 CW. AV1,E↔CCW. AV,E
04700 LAC AV2,AV↔GO L0
04800
04900 ;ADVANCE CCW AN ARC-EDGE OR EXIT.
05000 L3: CAMN AV2,ARG2↔RET3
05100 LAC AV1,AV2↔CCW E,AV2↔CCW AV2,E↔GO L0
05200 BEND
00100 ;PGON ← MKVIC;
00200 SUBR(MKVIC)
00300 BEGIN MKVIC
00400
00500 ACCUMULATORS{A2,A3,RC,MASK,I,PTR,D,E,A12,V}
00600 LAC I,ISAVED
00700 CDR PTR,ARG1
00800 SLIMZ I↔LAP PAC↔DAC PACPTR#; PAC POINTER INDEXED BY I.
00900
01000 ;FIND THE ROW & COL OF THE UPPER LEFT MOST VSEG.
01100 L1: SKIPE 1,VSEG(I)↔GO L2
01200 AOS I↔CAIE I,=1728↔GO L1
01300 SETZ 1,↔RET0;EMPTY.
01400
01500 L2: DAC I,ISAVED↔JFFO 1,.+1↔SLIMZ MASK,400000
01600 MOVNS 2↔LSH MASK,(2)↔MOVNS 2
01700 LAC RC,I↔ANDI RC,7↔IMULI RC,=36↔ADD RC,2 ;COLUMN.
01800 LAC I↔LSH -3↔DIP RC↔LSH RC,6 ;ROW.
01900
02000 ;DISTINGUISH BLOBS FROM HOLES.
02100 SETZM HOLE#
02200 TDNN MASK,@PACPTR; HOLE OR BLOB ?
02300 SETOM HOLE#;HOLE'A'COMING.
02400
02500 ;...AND HEAD SOUTH.
02600 DAC RC,RCMIN#↔SETZM RCMAX#↔SETZ V,↔SETZM ECNT#
02700 PUSHJ P,FOLLOW↔LAC V,V0↔CCW. V,E↔CW. E,V
02800 ;MAKE & RETURN VIC POLYGON.
02900 CALL GETBLK↔DAC 1,PTR
03000 LAC 1,ECNT↔SKIPE HOLE#↔MOVNS 1 ; -CNT INDICATES A HOLE.
03100 DAC 1,-1(PTR)↔CCW E,V↔DIP E,1(PTR)↔LAC 1,PTR
03200 L3: RET0
03300
03400 DEFINE TRY (SEG,YES) {
03500 LAC SEG(I)↔TDZN MASK↔GO .+3↔DAC SEG(I)↔GO YES}
03600 DEFINE LEFT {SUBI RC,100↔ROT MASK,1↔CAIN MASK,1↔SOS I}
03700 DEFINE RIGHT {ADDI RC,100↔ROT MASK,-1↔SKIPG MASK↔AOS I}
03800 DEFINE UP {SUB RC,[1B11]↔SUBI I,8}
03900 DEFINE DOWN {ADD RC,[1B11]↔ADDI I,8}
04000 DEFINE DEL $ (A,B){LAC D,[XWD 0$A$30,0$B$30]}
04100
00100 ;CREAT NEW EDGE AND VERTEX.
00200 TURN: 0
00300 ADD D,RC
00400 AOS 2,ECNT
00500
00600 ;VERTEX
00700 CALL GETBLK
00800 SKIPN V↔GO[DAC 1,V0#↔DAC 1,V↔GO T2]
00900 DAC 1,V↔DIP 2,(V)
01000 CCW. V,E↔CW. E,V
01100 T2: DAC D,-1(V)
01200 CAMLE D,RCMAX
01300 GO[DAC D,RCMAX↔DAC V,V1#↔GO .+1]
01400
01500 ;EDGE
01600 CALL GETBLK
01700 DAC 1,E↔DIP 2,(E)
01800 CCW. E,V↔CW. V,E
01900 GO @TURN
00100 NORTH: ADD D,[1B11]↔JSR TURN
00200 NORTH2: LEFT↔DEL(+,-)↔ TRY HSEG,WEST
00300 RIGHT↔UP↔ TRY VSEG,NORTH2
00400 DOWN↔DEL(+,+)↔ TRY HSEG,EAST↔FATAL(NORTH)
00500 NORTH3: ADD D,[1B11]↔JSR TURN↔LEFT
00600 NORTH4: UP↔DEL(+,-)↔ TRY HSEG,WEST↔GO NORTH4
00700
00800
00900 WEST: ADDI D,100↔JSR TURN
01000 WEST2: CAMN RC,RCMIN↔POPJ P,;TRY FOR E.O.VIC.
01100 FOLLOW: DEL(+,+)↔ TRY VSEG,SOUTH
01200 LEFT↔ TRY HSEG,WEST2
01300 RIGHT↔UP↔DEL(-,+)↔TRY VSEG,NORTH↔FATAL(WEST)
01400
01500
01600 SOUTH: JSR TURN
01700 SOUTH2: DOWN↔DEL(-,+)
01800 CAR RC↔CAIN =216B29↔GO EAST3
01900 TRY HSEG, EAST
02000 TRY VSEG,SOUTH2
02100 LEFT↔DEL(-,-)↔ TRY HSEG,WEST↔ FATAL(SOUTH)
02200
02300
02400 EAST: JSR TURN
02500 EAST2: RIGHT↔DEL(-,-)
02600 CDR RC↔CAIN =288B29↔GO NORTH3
02700 UP↔ TRY VSEG,NORTH
02800 DOWN↔ TRY HSEG,EAST2
02900 DEL(+,-)↔ TRY VSEG,SOUTH↔FATAL(EAST)
03000 EAST3: JSR TURN↔UP
03100 EAST4: RIGHT↔DEL(-,-)
03200 CDR RC↔CAIN =288B29↔GO[DOWN↔GO NORTH3]
03300 TRY VSEG,NORTH↔GO EAST4
03400
03500
03600
00100 ;MAKE PROTO ARC POLYGON USING V0 AND V1.
00200 SUBR(MKPAP)
00300 AV1←MASK↔AV2←I
00400 CALL GETBLK↔DAC 1,PTR
00500 CALL GETBLK↔DAC 1,E
00600 CALL GETBLK↔DAC 1,D
00700 CALL GETBLK↔DAC 1,AV1↔LAC 1,V0↔ARC. 1,AV1↔ARC. AV1,1
00800 LAC -1(1)↔DAC -1(AV1)
00900 CCW. E,AV1↔CW. AV1,E↔CCW. AV1,D↔CW. D,AV1
01000 CALL GETBLK↔DAC 1,AV2↔LAC 2,V1↔ARC. 2,AV2↔ARC. AV2,2
01100 LAC -1(2)↔DAC -1(AV2)
01200 CCW. D,AV2↔CW. AV2,D↔CCW. AV2,E↔CW. E,AV2
01300 DIP E,1(PTR)↔LAC 1,PTR↔RET0
01400 BEND
01500 END